home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / code / weak.lisp < prev    next >
Encoding:
Text File  |  1992-05-30  |  1.7 KB  |  47 lines
  1. ;;; -*- Mode: Lisp; Package: EXTENSIONS; Log: code.log -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: weak.lisp,v 1.2 91/02/08 13:36:39 ram Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; $Header: weak.lisp,v 1.2 91/02/08 13:36:39 ram Exp $
  15. ;;;
  16. ;;; Weak Pointer Support.
  17. ;;;
  18. ;;; Written by Christopher Hoover.
  19. ;;; 
  20.  
  21. (in-package "EXTENSIONS")
  22.  
  23. (export '(weak-pointer weak-pointer-p make-weak-pointer weak-pointer-value))
  24.  
  25. (defun make-weak-pointer (object)
  26.   "Allocates and returns a weak pointer which points to OBJECT."
  27.   (c::%make-weak-pointer object nil))
  28.  
  29. (defun weak-pointer-value (weak-pointer)
  30.   "If WEAK-POINTER is valid, returns the value of WEAK-POINTER and T.
  31.   If the referent of WEAK-POINTER has been garbage collected, returns
  32.   the values NIL and NIL.  The value may be set with SETF."
  33.   (declare (type weak-pointer weak-pointer))
  34.   (without-gcing
  35.     (let ((value (c::%weak-pointer-value weak-pointer))
  36.       (broken (c::%weak-pointer-broken weak-pointer)))
  37.       (values value (not broken)))))
  38.  
  39. (defun set-weak-pointer-value (weak-pointer new-value)
  40.   (declare (type weak-pointer weak-pointer))
  41.   (without-gcing
  42.     (setf (c::%weak-pointer-value weak-pointer) new-value)
  43.     (setf (c::%weak-pointer-broken weak-pointer) nil)
  44.     new-value))
  45.  
  46. (defsetf weak-pointer-value set-weak-pointer-value)
  47.